home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / graphics / amicad / arexx_english / testnets.amicad < prev    next >
Text File  |  1999-12-06  |  8KB  |  292 lines
  1. /* $VER: TestNets 1.02e (© R.Florac, 22 mai 1999) */
  2.  
  3. options results     /* indispensable pour récupérer le résultat des macros */
  4.  
  5. signal on error     /* pour l'interception des erreurs */
  6. signal on syntax
  7.  
  8. c=1
  9. 'INIT(B,D,L,O,N):SAVEALL(-1):UNMARK(-1):OBJECTS(-1)'; objets=result
  10. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  11.  
  12. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  13. c="Check sheet"||'0a'x||"1- Check references "||'0a'x||"2- Check values"||'0a'x||"3- Check connexions"||'0a'x||"4- Check nets"||'0a'x||"5- Check superpositions"||'0a'x
  14. c=c||"6- Chain all"||'0a'x||"7- Abort"
  15. 'SELECT("'c'")'
  16. c=result
  17. select
  18.     when c=1 then call test_refs
  19.     when c=2 then call test_valeurs
  20.     when c=3 then call test_connexions
  21.     when c=4 then call test_liaisons
  22.     when c=5 then call test_doublets
  23.     when c=6 then do
  24.     call test_doublets
  25.     call test_refs
  26.     call test_valeurs
  27.     call test_connexions
  28.     call test_liaisons
  29.     end
  30.     otherwise do
  31.     'INIT(B,D,L,O,N)'
  32.     exit
  33.     end
  34. end
  35. call afficher_erreurs
  36. 'INIT(B,D,L,O,N)'
  37. exit
  38.  
  39. test_refs:
  40.     'LOCK(-1):TITLE("Checking references...")'
  41.     do i=1 to objets
  42.     'TYPE(O='i')'
  43.     if result=1 then do
  44.         'PARTNAME(O)'
  45.         if result~="POWER SUPPLY" & result ~="GROUND" then do
  46.         'GETREF(O)'
  47.         if result=0 then do
  48.             'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no reference"+CHR(10)+"Do you want to continue?")'
  49.             if result<1 then do
  50.             'UNLOCK(-1)'
  51.             return
  52.             end
  53.             'UNMARKCOMP(O)'
  54.             errrefs=errrefs+1
  55.         end
  56.         end
  57.     end
  58.     end
  59.     'UNLOCK(-1)'
  60. return
  61.  
  62. test_valeurs:
  63.     'LOCK(-1):TITLE("Checking values..."):UNMARK(-1)'
  64.     do i=1 to objets
  65.     'TYPE(O='i')'
  66.     if result=1 then do
  67.         'PARTNAME(O)'
  68.         if result~="POWER SUPPLY" & result ~="GROUND" then do
  69.         'GETVAL(O)'
  70.         if result=0 then do
  71.             'MARK(O):REQUEST("Warning: object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have no value"+CHR(10)+"Do you want to continue?")'
  72.             if result<1 then do
  73.             'UNLOCK(-1)'
  74.             return
  75.             end
  76.             'UNMARKCOMP(O)'
  77.             errvals=errvals+1
  78.         end
  79.         end
  80.     end
  81.     end
  82.     'UNLOCK(-1)'
  83. return
  84.  
  85. test_doublets:
  86.     'LOCK(-1):TITLE("Checking superpositions..."):UNMARK(-1)'
  87.     i=1
  88.     do while i>0
  89.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  90.     if i>0 then do
  91.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  92.         if j>0 then do
  93.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS(-1)'; objets=result
  94.         doublets=doublets+1
  95.         end
  96.         if i>=objets-1 then i=0
  97.         else i=i+1
  98.     end
  99.     end
  100.     i=1
  101.     do while i>0
  102.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  103.     if i>0 then do
  104.         'GETREF(O)'; r=result
  105.         if r>0 then do
  106.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  107.         if d>0 then do
  108.             'MARK(O,D):MESSAGE("Warning: reference"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"is used twice!")'
  109.         end
  110.         end
  111.         if i>=objets-1 then i=0
  112.         else i=i+1
  113.     end
  114.     end
  115.     'UNLOCK(-1)'
  116. return
  117.  
  118. test_connexions:
  119.     'LOCK(-1):TITLE("Checking junctions to components..."):UNMARK(-1)'
  120.     i=1
  121.     do while i>0
  122.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  123.     if i>0 then do
  124.         'PARTNAME(O)'
  125.         'DEVPINS(O)'; j=result
  126.         do k=1 to j
  127.         if connexion_broche(i,k)=0 then do
  128.             'MARK(O):REQUEST("Warning object 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"located in "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"have his pin "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" not connected"+CHR(10)+"Do you want to continue?")'
  129.             if result<1 then do
  130.             'UNLOCK(-1)'
  131.             return
  132.             end
  133.             'UNMARKCOMP(O)'
  134.             errconx=errconx+1
  135.         end
  136.         end
  137.         if i=objets then leave
  138.         i=i+1
  139.     end
  140.     end
  141.     'UNLOCK(-1)'
  142. return
  143.  
  144. test_liaisons:
  145.     'LOCK(-1):TITLE("Looking for unused lines...")'
  146.     i=1
  147.     do while i>0
  148.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  149.     if i>0 then do
  150.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  151.         if result>0 then do
  152.         objets=result
  153.         eliminations=eliminations+1
  154.         end
  155.         else if i<objets then do
  156.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  157.         if result=1 then do    /* c'est une ligne verticale */
  158.             l=i+1
  159.             do while l>0
  160.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  161.             if l>0 then do
  162.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  163.                 if result~="" then do
  164.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  165.                 y4=min(y0,y1)
  166.                 y5=max(y0,y1)
  167.                 y6=min(y2,y3)
  168.                 y7=max(y2,y3)
  169.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  170.                 else if y4=y7 then do
  171.                     'FINDOBJ(1,7,'x0','y4')'
  172.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  173.                 end
  174.                 else if y5=y6 then do
  175.                     'FINDOBJ(1,7,'x0','y5')'
  176.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  177.                 end
  178.                 end
  179.             end
  180.             if l>0 then do
  181.                 if l>=objets then l=0
  182.                 else l=l+1
  183.             end
  184.             end
  185.         end
  186.         else if result=2 then do    /* c'est une ligne horizontale */
  187.             l=i+1
  188.             do while l>0
  189.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  190.             if l>0 then do
  191.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")' /* est-ce bien une ligne horizontale? */
  192.                 if result~="" then do
  193.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  194.                 x4=min(x0,x1)
  195.                 x5=max(x0,x1)
  196.                 x6=min(x2,x3)
  197.                 x7=max(x2,x3)
  198.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  199.                 else if x4=x7 then do
  200.                     'FINDOBJ(1,7,'x4','y0')'
  201.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  202.                 end
  203.                 else if x5=x6 then do
  204.                     'FINDOBJ(1,7,'x5','y0')'
  205.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  206.                 end
  207.                 end
  208.             end
  209.             if l>0 then do
  210.                 if l>=objets then l=0
  211.                 else l=l+1
  212.             end
  213.             end
  214.         end
  215.         end
  216.         if i>=objets-1 then i=0
  217.         else i=i+1
  218.     end
  219.     else leave
  220.     end
  221.     'UNLOCK(-1)'
  222. return
  223.  
  224. afficher_erreurs:
  225.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Checking ended"+CHR(10)+"No error found")'
  226.     else do
  227.     t=""
  228.     if eliminations>0 then t=eliminations||" unused lines deleted"
  229.     if modifs>0 then do
  230.         if t~="" then t=t||'0a'x||modifs||" modified lines"
  231.         else t=modifs||" modified lines"
  232.     end
  233.     if errrefs>0 then do
  234.         if t~="" then t=t||'0a'x||errrefs||" missing references"
  235.         else t=errrefs||" missing references"
  236.     end
  237.     if errvals>0 then do
  238.         if t~="" then t=t||'0a'x||errvals||" missing values"
  239.         else t=errvals||" missing values"
  240.     end
  241.     if errconx>0 then do
  242.         if t~="" then t=t||'0a'x||errconx||" missing connexions"
  243.         else t=errconx||" missing connexions"
  244.     end
  245.     if doublets>0 then do
  246.         if t~="" then t=t||'0a'x||doublets||" deleted objects"
  247.         else t=doublets||" deleted objects"
  248.     end
  249.     'MESSAGE("'t'")'
  250.     end
  251.     return
  252.  
  253. modifier_lignes:
  254.     parse arg xd,yd,xf,yf
  255.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  256.     objets=objets-1
  257.     i=0; l=0
  258.     modifs=modifs+1
  259.     return
  260.  
  261. connexion_broche: procedure
  262.     parse arg objet,broche
  263.     'PINCOL(O='objet',B='broche')'; xj=result
  264.     'PINLINE(O,B)'; yj=result
  265.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  266.     if xl>0 then return xl
  267.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  268.     if xl<=0 then return 0
  269.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  270.     if result>0 then return xl
  271.     return 0
  272.  
  273. min: procedure
  274.     parse arg v1,v2
  275.     if v1<v2 then return v1
  276.     return v2
  277.  
  278. max: procedure
  279.     parse arg v1,v2
  280.     if v1>v2 then return v1
  281.     return v2
  282.  
  283. /* Traitement des erreurs, interruption du programme */
  284. syntax:
  285. erreur=RC
  286. 'UNLOCK(-1):MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  287. exit
  288.  
  289. error:
  290. 'UNLOCK(-1):MESSAGE("Script TestNets.AmiCAD"+CHR(10)+"Error in line 'SIGL'")'
  291. exit
  292.